home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / MODEX104.ZIP / CHARDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-05-14  |  3.4 KB  |  165 lines
  1. DEFINT A-Z
  2. DECLARE SUB PRINT.STRING (Text$, Xpos%, Ypos%, Colour%)
  3. DECLARE FUNCTION MakePal$ (Red%, Green%, Blue%)
  4. DECLARE SUB LOAD.FONT (FontFile$, FontNum%)
  5. DECLARE SUB ERROR.OUT (Text$)
  6.  
  7.     REM $INCLUDE: 'MODEX.BI'
  8.  
  9.     REM $INCLUDE: 'UTILS.BI'
  10.  
  11. TYPE FONT
  12.     SetData AS STRING * 1024
  13. END TYPE
  14.  
  15.  
  16. TYPE VGAPalette
  17.     PalData AS STRING * 768
  18. END TYPE
  19.  
  20.  
  21.     ' Alternate form of LOAD_DAC_REGISTERS so we can pass an offset into
  22.     ' a String instead of the Address of the String
  23.  
  24. DECLARE SUB LOAD.DACS ALIAS "LOAD_DAC_REGISTERS" (BYVAL Addr&, BYVAL StartReg%, BYVAL EndReg%, BYVAL VSync%)
  25.  
  26.  
  27.     '
  28.     'MODE X DEMO of Multiple Character Sets and Block Color Cycling
  29.     '
  30.     'By Matt Pritchard
  31.     '
  32.  
  33. COMMON SHARED CharSet() AS FONT
  34.  
  35. DIM Pal AS VGAPalette
  36.  
  37.     REM $DYNAMIC
  38.  
  39. DIM SHARED CharSet(0 TO 3) AS FONT
  40.  
  41.  
  42.     LOAD.FONT "SYSTEM.FNT", 0
  43.     LOAD.FONT "ROM_8x8.FNT", 1
  44.     LOAD.FONT "SPACEAGE.FNT", 2
  45.  
  46.  
  47.     IF SET.MODEX(Mode320x240) = False THEN
  48.         ERROR.OUT "ERROR SETTING MODE X"
  49.     END IF
  50.  
  51.  
  52.     A$ = "": B$ = ""
  53.     FOR X = 0 TO 31: A$ = A$ + MakePal$(31 - X, X, 0): NEXT X
  54.     FOR X = 0 TO 31: A$ = A$ + MakePal$(0, 31 - X, X): NEXT X
  55.     FOR X = 0 TO 31: A$ = A$ + MakePal$(X, 0, 31 - X): NEXT X
  56.    
  57.     FOR X = 0 TO 31: B$ = B$ + MakePal$(31 - X, X, X): NEXT X
  58.     FOR X = 0 TO 31: B$ = B$ + MakePal$(X, 31 - X, X): NEXT X
  59.     FOR X = 0 TO 31: B$ = B$ + MakePal$(X, X, 31 - X): NEXT X
  60.  
  61.     Black$ = STRING$(192, 0)
  62.     White$ = STRING$(128 * 3, 48)
  63.  
  64.     Pal1$ = Black$ + A$ + A$ + B$ + B$ + A$
  65.  
  66.     LOAD.DACS SSEGADD(Black$), 64, 127, 1
  67.     LOAD.DACS SSEGADD(Black$), 20, 63, 0
  68.  
  69.     LOAD.DACS SSEGADD(White$), 128, 255, 0
  70.  
  71.     '*** Background ***
  72.  
  73.     FOR X = 0 TO 319
  74.         FOR Y = 0 TO 239
  75.            IF ((X + Y) AND 1) = 1 THEN SET.POINT X, Y, 64 + X \ 5 ELSE SET.POINT X, Y, 20 + Y \ 6
  76.         NEXT Y
  77.     NEXT X
  78.  
  79.     '*** Draw Font Displays ***
  80.  
  81.     PRINT.STRING "FONT: SYSTEM.FNT", 11, 7, 15
  82.     PRINT.STRING "FONT: ROM_8x8.FNT", 11, 17, 15
  83.     PRINT.STRING "FONT: SPACEAGE.FNT", 11, 27, 15
  84.     PRINT.STRING "PRESS ANY KEY TO CONTINUE", 8, 29, 14
  85.     
  86.  
  87.     FOR F = 0 TO 2
  88.         SET.DISPLAY.FONT CharSet(F), 1
  89.         Yp = F * 80 + 10
  90.         FOR Y = 0 TO 96 STEP 32
  91.             FOR X = 0 TO 31
  92.                 TGPRINTC 128 + Y + X, X * 10 + 1, Yp, 128 + Y
  93.             NEXT X
  94.         Yp = Yp + 10
  95.         NEXT Y
  96.     NEXT F
  97.  
  98.     DO
  99.     LOOP UNTIL SCAN.KEYBOARD
  100.  
  101.     Offset = 0
  102.     Restart = 192
  103.     MaxOfs = 192 + 96 * 6
  104.  
  105.     Delay = 100
  106.  
  107.     Offset2 = 0
  108.     Offset2Dir = 3
  109.     Offset2Min = 192
  110.     Offset2Max = Offset2Min + 192 * 6
  111.  
  112.     DO
  113.         LOAD.DACS SSEGADD(Pal1$) + Offset, 64, 127, 1
  114.         Offset = Offset + 3
  115.         IF Offset >= MaxOfs THEN Offset = Restart
  116.         IF Delay THEN
  117.             Delay = Delay - 1
  118.         ELSE
  119.             LOAD.DACS SSEGADD(Pal1$) + Offset2, 20, 60, 0
  120.             IF Offset2 = Offset2Max THEN Offset2Dir = -3
  121.             IF Offset2 = Offset2Min THEN Offset2Dir = 3
  122.             Offset2 = Offset2 + Offset2Dir
  123.         END IF
  124.  
  125.     LOOP UNTIL SCAN.KEYBOARD
  126.  
  127.     ERROR.OUT "DEMO OVER"
  128.  
  129. REM $STATIC
  130. SUB ERROR.OUT (Text$)
  131.  
  132.     SET.VIDEO.MODE 3
  133.  
  134.     DOS.PRINT Text$
  135.  
  136.     END
  137.  
  138. END SUB
  139.  
  140. SUB LOAD.FONT (FontFile$, FontNum) STATIC
  141.  
  142.     IF LEN(DIR$(FontFile$)) = 0 THEN ERROR.OUT "FILE NOT FOUND: " + FontFile$
  143.  
  144.     OPEN FontFile$ FOR BINARY AS #1
  145.  
  146.         SEEK #1, 1
  147.         GET #1, , CharSet(FontNum)
  148.  
  149.     CLOSE #1
  150.  
  151. END SUB
  152.  
  153. FUNCTION MakePal$ (Red, Green, Blue) STATIC
  154.  
  155.     MakePal$ = CHR$(Red) + CHR$(Green) + CHR$(Blue)
  156.  
  157. END FUNCTION
  158.  
  159. SUB PRINT.STRING (Text$, Xpos, Ypos, Colour)
  160.  
  161.     TPRINT.STR SSEG(Text$), SADD(Text$), LEN(Text$), Xpos * 8, Ypos * 8, Colour
  162.  
  163. END SUB
  164.  
  165.